﻿namespace MailChimp.Types

#nowarn "60" // implementations in augmentations
#nowarn "69" // implementations in augmentations

open System
open System.IO
open System.Collections
open System.Collections.Generic
open System.ComponentModel
open System.Net
open System.Reflection
open System.Runtime.Serialization
open System.Runtime.InteropServices
open System.Text
open System.Xml
open System.Xml.Serialization

//==================================================================================
//  Common
//==================================================================================

[<AutoOpen>]
module internal Common =

    open System.Text.RegularExpressions

    // Current assembly
    let assembly = Assembly.GetExecutingAssembly()
    let getResource name = assembly.GetManifestResourceStream(name)
    let readStream (s: Stream) = (new StreamReader(s)).ReadToEnd()

    let inline isNullOrEmpty x = String.IsNullOrEmpty(x)
    let inline trim x = if isNullOrEmpty x then x else x.Trim()
    let inline regex c = Regex(c)
    let inline replace (rgx: Regex) (r: string) x = rgx.Replace(x, r)

    let xattr (n: string) (xr: XmlReader) =
        match xr.GetAttribute(n) with null -> "" | a -> a.ToLower()

    let convert<'T> x =
        let tc = TypeDescriptor.GetConverter(typeof<'T>)
        tc.ConvertFromString(x) :?> 'T

    let isoWeekDay (x: DayOfWeek) = let z = int x in if z = 0 then 7 else z
    let getBytesUTF8 (x: string) = Encoding.UTF8.GetBytes(x)
    let getBytesASCII (x: string) = Encoding.ASCII.GetBytes(x)

    //------------------------------------------------------------------------------
    //  (*) Serialization
    //------------------------------------------------------------------------------

    let getTransform = lazy(
        use xsl = getResource "SortDoc.xslt"
        let xct = Xsl.XslCompiledTransform()
        use xr = new XmlTextReader(xsl)
        xct.Load(xr); xct)

    let prepareXml x =
        let xct, sb = getTransform.Value, StringBuilder()
        use xr = new XmlTextReader(new StringReader(x))
        use xw = new XmlTextWriter(new StringWriter(sb))
        xct.Transform(xr, xw)
        sb.ToString()

    let createJsonReader s =
        Json.JsonReaderWriterFactory.CreateJsonReader(getBytesUTF8 s, XmlDictionaryReaderQuotas.Max)

    let deserializeXml<'T> (x: obj) =
        let xs = DataContractSerializer(typeof<'T>)
        match x with
        | :? string as s ->
            use xr = new XmlTextReader(new StringReader(s))
            xs.ReadObject(xr, false) :?> 'T
        | :? XmlReader as xr ->
            xs.ReadObject(xr, false) :?> 'T
        | _ -> invalidArg "x" ""

    let deserializeJson<'T> (x: obj) =
        let js = Json.DataContractJsonSerializer(typeof<'T>)
        match x with
        | :? string as s ->
            use ms = new MemoryStream(getBytesUTF8 s)
            js.ReadObject(ms) :?> 'T
        | :? XmlReader as xr ->
            js.ReadObject(xr, false) :?> 'T
        | _ -> invalidArg "x" ""

//------------------------------------------------------------------------------
//  (*) Reflection helper
//------------------------------------------------------------------------------

module private ReflectionHelper =

    open System.Collections.Concurrent
    open System.Linq.Expressions

    // Reflection cache
    type typdef = (string * Func<obj, obj>)[]
    let cache = ConcurrentDictionary<nativeint, typdef>()
    let enums = ConcurrentDictionary<Enum, string>()

    let getAttr<'T> (mi: MemberInfo) =
       let xs = mi.GetCustomAttributes(typeof<'T>, false)
       if xs.Length = 0 then None else Some (xs.[0] :?> 'T)

    let createDelegate (mi: MemberInfo) =
        match mi with
        | :? PropertyInfo as pi ->
            if not pi.CanRead then None else
            let inst = Expression.Parameter(typeof<obj>, "instance")
            let instCast =
                if pi.GetGetMethod(true).IsStatic then null
                else Expression.Convert(inst, pi.ReflectedType)
            let pa = Expression.Property(instCast, pi)
            let pv = Expression.Convert(pa, typeof<obj>)
            Expression.Lambda<Func<obj, obj>>(pv, inst).Compile() |> Some
        | :? FieldInfo as fi ->
            let inst = Expression.Parameter(typeof<obj>, "instance")
            let instCast =
                if fi.IsStatic then null
                else Expression.Convert(inst, fi.ReflectedType)
            let fa = Expression.Field(instCast, fi)
            let fv = Expression.Convert(fa, typeof<obj>)
            Expression.Lambda<Func<obj, obj>>(fv, inst).Compile() |> Some
        | _ -> None

    // Caches enums defined in this assembly only
    let getEnumValue (x: Enum) =
        if x = null then nullArg "x"
        if enums.ContainsKey(x) then enums.Item(x)
        else
            let typ = x.GetType() in let n = Enum.GetName(typ, x)
            if not (assembly.Equals(typ.Assembly)) then n
            else
                let mi = typ.GetField(n, BindingFlags.Public ||| BindingFlags.Static ||| BindingFlags.GetField)
                let v = match (getAttr<EnumMemberAttribute> mi) with
                        | None -> n
                        | Some a -> a.Value
                enums.GetOrAdd(x, v)

    let getTypeDef (typ: Type) =
        if typ = null then nullArg "typ"
        let id = typ.TypeHandle.Value
        if cache.ContainsKey(id) then cache.Item(id)
        else
            let rgx = regex "@$"
            let dlg =
                typ.GetMembers(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.NonPublic) |>
                Array.choose(fun z ->
                    match (getAttr<DataMemberAttribute> z) with
                    | None -> Option.None
                    | Some a ->
                        match (createDelegate z) with
                        | None -> None
                        | Some f ->
                            let n = if not (isNullOrEmpty a.Name) then a.Name
                                    else replace rgx "" z.Name
                            Some (n, f))
            cache.GetOrAdd(id, dlg)

//------------------------------------------------------------------------------
//  (*) Type abbreviations
//------------------------------------------------------------------------------

type internal httpst = HttpStatusCode
type internal op = OptionalAttribute
type internal dv = DefaultParameterValueAttribute

//==================================================================================
//  Input
//==================================================================================

type Input() =
    inherit Dictionary<string, obj>()

    member x.Remove(key) =
        base.Remove(key) |> ignore

    member x.Merge(p: Input) =
        for z in p do x.[z.Key] <- z.Value

    member x.Merge(p: IInput) =
        p.ToInput() |> x.Merge
and
 IInput =
    abstract ToInput: unit -> Input


type internal IValue =
    abstract member Value: obj

//------------------------------------------------------------------------------
//  (*) Input helper
//------------------------------------------------------------------------------

module internal InputHelper =

    open ReflectionHelper

    let dateStr (z: DateTime) = z.ToString("yyyy-MM-dd")
    let dateTimeStr (z: DateTime) = z.ToString("yyyy-MM-dd HH:mm:ss")

    let str (x: obj) =
        match x with
        | :? Enum as e -> getEnumValue e
        | :? bool as b -> if b then "1" else "0"
        | :? DateTime as d -> dateTimeStr d
        | _ -> string x

    let webStr x = str x |> Web.HttpUtility.UrlEncode

    let join delim (xs: string seq) = String.Join(delim, Array.ofSeq xs)

    let joinSeq delim (xs: 'T seq) =
        if xs = null then ""
        else
            let rpl = (regex @"(?<!.)\s*,\s*(?!.)").IsMatch(delim)
            let rxc, rxe = regex @",(?!\\)", regex @"\\$"
            xs |> Seq.map(fun x ->
                let z = str (box x)
                if rpl then trim z |> replace rxc "\," |> replace rxe @"\ " else z) |>
            join delim |> trim

    let split<'T> delim x =
        if isNullOrEmpty x then [||]
        elif (regex @"(?<!.)\s*,\s*(?!.)").IsMatch(delim) then
            let rx = regex @"\\,(?!\\)"
            (regex @"\s*(?<!\\),(?!\\)\s*").Split x |>
            Array.map(fun z -> replace rx "," z |> trim |> convert<'T>)
        else
            (regex delim).Split x |> Array.map(fun z -> convert<'T> z)

    let ofSeq (xs: IEnumerable) =
        let p = Input()
        if xs <> null then
            xs |> Seq.cast<obj> |> Seq.iteri(fun i v -> p.[string i] <- v)
        p

    let ofDict keyf (xd: IDictionary) =
        let p = Input()
        if xd <> null then
            for x in xd do
                let v = x :?> DictionaryEntry
                let key = string v.Key |> keyf
                if key <> String.Empty then p.[key] <- v.Value
        p

    //------------------------------------------------------------------------------
    //  (*) Handle input values
    //------------------------------------------------------------------------------

    let (|V|O|) (x: obj) =
        match x with
        | :? IValue as xv -> V xv.Value
        | :? IInput as xi -> O (xi.ToInput() |> box)
        | :? IDictionary | :? string -> O x
        | :? IEnumerable as xe -> O (ofSeq xe |> box)
        | _ -> O x

    let rec getValue v =
        match v with
        | V x -> getValue x
        | O x -> x

    //------------------------------------------------------------------------------
    //  (*) Build input helper
    //------------------------------------------------------------------------------

    let build (x: obj) =
        let p = Input()
        if x <> null then
            x.GetType() |> getTypeDef |> Array.iter (fun (n, f) -> p.[n] <- f.Invoke(x))
        p


module IH = InputHelper

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Input =

    let ofDict keyf xd = IH.ofDict keyf xd
    let ofSeq xs = IH.ofSeq xs

    //------------------------------------------------------------------------------
    //  (*) Bild query string
    //------------------------------------------------------------------------------

    let buildQueryString (x: Input) =
        let inline fmt key = if key = "" then "{0}{1}" else "{0}[{1}]"

        let rec aux (ko: string) (xs: IDictionary) =
            seq { for x in xs do
                    let v = x :?> DictionaryEntry
                    let ki, z = v.Key, IH.getValue v.Value
                    match z with
                    | null -> ()
                    | :? IDictionary as xd ->
                        if xd.Count > 0 then
                           yield aux (String.Format(fmt ko, ko, ki)) xd
                    | _ -> yield String.Format((fmt ko) + "={2}", ko, ki, IH.webStr z)
            } |> IH.join "&"
        aux "" x

//==================================================================================
//  Helper types
//==================================================================================

[<DefaultAugmentation(false)>]
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
[<System.Diagnostics.DebuggerDisplay("Some({Value})")>]
type Opt<'T> =
    | None
    | Some of 'T

    [<CompilationRepresentation(CompilationRepresentationFlags.Instance)>]
    member x.Value =
        match x with
        | None -> invalidOp "No value"
        | Some v -> v

    static member op_Explicit(x: 'T opt) = x.Value
    static member op_Implicit(x: 'T) = Some x

    static member None: 'T opt = None
    static member Some(x): 'T opt = Some x

    override x.ToString() =
        match x with
        | None -> String.Empty
        | Some v -> string (box v)

    interface IValue with
        member x.Value = match x with None -> null | Some v -> box v
and
 'T opt = Opt<'T>


[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Opt =

    let Some x = Some x
    let IsNone x = match x with None   -> true | _ -> false
    let IsSome x = match x with Some _ -> true | _ -> false
    let GetValue (x: 'T opt) = x.Value

    let toOption x = match x with None -> Option.None | Some v -> Option.Some v
    let ofOption x = match x with Option.None -> None | Option.Some v -> Some v


[<Struct>]
[<CustomEquality; CustomComparison>]
type MCNull<'T> when 'T : struct =
    interface System.IComparable

    val mutable private value: 'T
    val mutable private hasValue: bool

    new(v) = { value = v; hasValue = true }

    member x.HasValue = x.hasValue
    member x.Value = if x.hasValue then x.value else failwith "No value"

    static member op_Explicit(x: 'T mcnull) = x.Value
    static member op_Implicit(x: 'T) = MCNull x

    interface IValue with
        member x.Value = if x.HasValue then box x.Value else null

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null

        member x.WriteXml xw =
            if x.hasValue then xw.WriteValue(x.Value)
            else xw.WriteValue(null)

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            if not xr.IsEmptyElement then
                x.value <- deserializeXml<'T> xr
                x.hasValue <- true

and
 'T mcnull when 'T : struct = MCNull<'T>


module private MCNull =

    let gec = LanguagePrimitives.GenericEqualityComparer
    let gc  = LanguagePrimitives.GenericComparer

    let equalNV (x: MCNull<'T>) (y: 'T) =
        if not x.HasValue then false
        else gec.Equals(x.Value, y)

    let equalNN (x: MCNull<'T>) (y: MCNull<'T>) =
        if not y.HasValue then not x.HasValue
        else equalNV x y.Value

    let hash (x: MCNull<'T>) =
        if x.HasValue then gec.GetHashCode(x.Value) else 0

    let str (x: MCNull<'T>) =
        if x.HasValue then x.Value.ToString() else String.Empty

    let compareNV (x: MCNull<'T>) (y: 'T) =
        if not x.HasValue then -1
        else gc.Compare(x.Value, y)

    let compareNN (x: MCNull<'T>) (y: MCNull<'T>) =
        if not y.HasValue then
            if x.HasValue then 1 else 0
        else compareNV x y.Value


type MCNull with

    override x.Equals(o: obj) =
        if o = null then not x.hasValue
        else match o with
             | :? MCNull<'T> as v -> MCNull.equalNN x v
             | :? 'T as v -> MCNull.equalNV x v
             | _ -> false

    override x.GetHashCode() = MCNull.hash x
    override x.ToString() = MCNull.str x

    interface System.IComparable with
        member x.CompareTo(o: obj) =
            if o = null then
                if x.HasValue then 1 else 0
            else match o with
                 | :? MCNull<'T> as v -> MCNull.compareNN x v
                 | :? 'T as v -> MCNull.compareNV x v
                 | _ -> 0


[<Struct>]
type MCBool =
    val mutable Value: bool

    new(v) = { Value = v }

    static member op_Explicit(x: MCBool) = x.Value
    static member op_Implicit(x: bool) = MCBool x

    override x.ToString() = if x.Value then "1" else "0"

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null

        member x.WriteXml xw =
            xw.WriteValue(x.Value)

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            if not xr.IsEmptyElement then
                x.Value <- XmlConvert.ToBoolean <| xr.ReadElementString()


[<Struct>]
type MCDateTime =
    val mutable Value: DateTime

    new(v) = { Value = v }

    static member op_Explicit(x: MCDateTime) = x.Value
    static member op_Implicit(x: DateTime) = MCDateTime x

    override x.ToString() = IH.dateTimeStr x.Value

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null

        member x.WriteXml xw =
            xw.WriteValue(x.Value)

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            if not xr.IsEmptyElement then
                x.Value <- DateTime.Parse <| xr.ReadElementString()


type internal LineReader(s: Stream) =
    inherit StreamReader(s)

    let mutable linenum = 0

    member x.LineNum = linenum

    override x.ReadLine() =
        linenum <- linenum + 1; base.ReadLine()

//------------------------------------------------------------------------------
//  (*) Operators
//------------------------------------------------------------------------------

[<AutoOpen>]
module internal Operators =

    let (>?) x = Opt.toOption x
    let (<?) x = Opt.ofOption x
    let (@?) x y = if x = null then y else x
    let (==) x y = obj.Equals(x, y)
    let (!=) x y = not (x == y)
    let defValue x y = match x with None -> y | Some v -> v

//------------------------------------------------------------------------------
//  (*) Specialized collections
//------------------------------------------------------------------------------

[<DefaultAugmentation(false)>]
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
type MCSeq<'T> =
    | Null
    | Sn of 'T
    | Sq of 'T seq

    [<CompilationRepresentation(CompilationRepresentationFlags.Instance)>]
    member x.SnValue = match x with Sn v -> v | _ -> invalidOp "Value is not Sn"
    [<CompilationRepresentation(CompilationRepresentationFlags.Instance)>]
    member x.SqValue = match x with Sq v -> v | _ -> invalidOp "Value is not Sq"

    static member op_Implicit(x: 'T) = Sn x
    static member op_Implicit(x: 'T seq) = Sq x
    static member op_Explicit(x: 'T mcseq) = x.SnValue
    static member op_Explicit(x: 'T mcseq) = x.SqValue

    static member Null: 'T mcseq = Null
    static member Create(x): 'T mcseq = Sn x
    static member Create(x): 'T mcseq = Sq x

    override x.ToString() =
        (match x with
         | Null -> ""
         | Sn v -> IH.joinSeq ", " [v]
         | Sq v -> IH.joinSeq ", "  v).Replace(@",\", ",")

    interface IValue with
         member x.Value = string x |> box

and
 'T mcseq = MCSeq<'T>


[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module MCSeq =

    let Sn x = Sn x
    let Sq x = Sq x
    let IsSn x   = match x with Sn _ -> true | _ -> false
    let IsSq x   = match x with Sq _ -> true | _ -> false
    let IsNull x = match x with Null -> true | _ -> false

    let toArray x =
        match x with Null -> [||] | Sn v -> [|v|] | Sq v -> Seq.toArray v

    let parse<'T> x =
        let z = IH.split<'T> "," x
        match z.Length with 0 -> Null | 1 -> Sn z.[0] | _ -> Sq z


type VarList<'T,'V> when 'V :> 'T seq (value) =
    let mutable value: 'T mcseq = value

    member x.Value
        with get() = value
        and internal set(v) = value <- v

    new() = VarList(Null)

    override x.ToString() = string value

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null
        member x.WriteXml xw = ()

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            if xr.IsEmptyElement then value <- Null
            elif xattr "type" xr = "array" then
                 value <- Sq (deserializeXml<'V> xr)
            else value <- Sn (deserializeXml<'T> xr)


[<CollectionDataContract(Namespace = "", ItemName = "struct")>]
[<AllowNullLiteral>]
type MCList<'T> =
    inherit List<'T>

    new() = { inherit List<'T>() }
    new(seq: 'T seq) = { inherit List<'T>(seq) }

    static member ofSeq(xs: 'T seq) = MCList(xs)


[<CollectionDataContract(Namespace = "", ItemName = "value")>]
[<AllowNullLiteral>]
type MVList<'T> =
    inherit List<'T>

    new() = { inherit List<'T>() }
    new(seq: 'T seq) = { inherit List<'T>(seq) }

    static member ofSeq(xs: 'T seq) = MVList(xs)


[<AllowNullLiteral>]
type MCDict<'T> =
    inherit Dictionary<string,'T>

    new() =
      { inherit Dictionary<string,'T>() }
    new(dict: IDictionary<string,'T>) =
      { inherit Dictionary<string,'T>(dict) }

    static member ofSeq(xs: (string * 'T) seq) =
        MCDict<'T>(dict xs)

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null

        member x.WriteXml xw =
            let xs = DataContractSerializer(typeof<'T>)
            for z in x do
                xw.WriteStartElement(z.Key)
                xs.WriteObjectContent(xw, z.Value)
                xw.WriteEndElement()

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            let mutable s = xr.Read()
            while s do
                if xr.NodeType = XmlNodeType.Element then
                    (xr.LocalName, deserializeXml<'T> xr) |> x.Add
                else s <- xr.Read()


[<AllowNullLiteral>]
type MCDict<'K,'T> when 'K : equality =
    inherit Dictionary<'K,'T>

    new() =
      { inherit Dictionary<'K,'T>() }
    new(dict: IDictionary<'K,'T>) =
      { inherit Dictionary<'K,'T>(dict) }

    static member ofSeq(xs: ('K * 'T) seq) =
        MCDict<'K,'T>(dict xs)

    interface IXmlSerializable with
        member IXmlSerializable.GetSchema() = null

        member x.WriteXml xw =
            let xs = DataContractSerializer(typeof<'T>)
            for z in x do
                xw.WriteStartElement("struct")
                xw.WriteAttributeString("key", string (box z.Key))
                xs.WriteObjectContent(xw, z.Value)
                xw.WriteEndElement()

        member x.ReadXml xr =
            xr.MoveToContent() |> ignore
            let mutable s = xr.Read()
            while s do
                if xr.NodeType = XmlNodeType.Element then
                    (xr.GetAttribute("key") |> convert<'K>,
                     deserializeXml<'T> xr) |> x.Add
                else s <- xr.Read()


open System.Collections.Specialized

[<AllowNullLiteral>]
[<StructuredFormatDisplay("{StructuredDislpay}")>]
type NestedDict() =
    inherit Dictionary<string, NestedDictValue>()
and
 NestedDictValue =
    | Empty
    | Value of string
    | Dict of NestedDict

    static member op_Implicit(x) = Value x
    static member op_Implicit(x) = Dict x

    static member op_Explicit(x): string =
        match x with Value v -> v | _ -> invalidOp "Value is not 'Value' type."

    static member op_Explicit(x): NestedDict =
        match x with Dict d -> d | _ -> invalidOp "Value is not 'Dict' type."


module private NestedDictHelper =

    let getItem (path: string) (d: NestedDict) =
        let rx = regex "(?<!/)//"
        let p = (regex "(?<!/)/(?!/)").Split path |> Array.map(fun x -> rx.Replace(x, "/"))

        let rec aux i (x: NestedDict) =
            if i >= p.Length then Empty
            elif x.ContainsKey(p.[i]) then
                let v = x.[p.[i]]
                if i = p.Length - 1 then v else
                match v with
                | Dict z -> aux (i + 1) z
                | _ -> Empty
            else Empty
        aux 0 d

    let parseQueryString (xs: NameValueCollection) =
        let ks = xs.AllKeys |> Array.map(fun x ->
            x.Split([|"["; "]"|], StringSplitOptions.RemoveEmptyEntries), xs.Item(x))

        let rec aux (kvs: (string[] * string)[]) i (x: NestedDict) =
            if kvs.Length = 1 then
                let (k, v) = kvs.[0]
                if i >= k.Length then Value v else
                x.Add (k.[i], aux (kvs) (i + 1) (NestedDict()))
                Dict x
            else
                kvs |> Seq.groupBy(fun (z, _) -> if i >= z.Length then null else z.[i]) |>
                Seq.iter(fun (k, v) -> x.Add(k, aux (Seq.toArray v) (i + 1) (NestedDict())))
                Dict x

        let d = NestedDict()
        aux ks 0 d |> ignore; d

    let stringRpt (x: NestedDict) =
        let rec aux prefix (d: NestedDict) (sb: StringBuilder) =
            for k in d do
                sb.AppendFormat("{0}[{1}]: ", prefix, k.Key) |> ignore
                (match k.Value with
                 | Empty   -> sb.AppendLine("<empty>")
                 | Value v -> sb.AppendLine(v)
                 | Dict  z -> sb.AppendLine() |> aux (prefix + "\t") z) |> ignore
            sb
        StringBuilder() |> aux "" x |> string


module NH = NestedDictHelper

type NestedDict with

    member x.StructuredDislpay = x.ToString()
    override x.ToString() = NH.stringRpt x
    member x.Get(path: string) = NH.getItem path x

    member x.GetDict(path: string) =
        match x.Get(path) with
        | Dict d -> d
        | _ -> null

    member x.GetValue(path: string) =
        match x.Get(path) with
        | Value v -> v
        | _ ->  null

    static member ParseQueryString(x, ?encoding:Encoding) =
        (match encoding with
         | Option.None -> Web.HttpUtility.ParseQueryString(x)
         | Option.Some v -> Web.HttpUtility.ParseQueryString(x, v)) |>
        NH.parseQueryString

    static member ParseQueryString(xs) = NH.parseQueryString xs

//------------------------------------------------------------------------------
//  (*) Misc
//------------------------------------------------------------------------------

[<DataContract(Namespace = "")>]
type SortDirection =
    | [<EnumMember>] Asc = 0
    | [<EnumMember>] Desc = 1

//==================================================================================
//  Api Error
//==================================================================================

[<DataContract(Namespace = "")>]
type Error internal (msg, code) =
    internal new() = Error(null, 0)

    abstract Message: string
    default x.Message = msg

    abstract Code: int
    default x.Code = code

    override x.ToString() =
        String.Format("{0}: {1}", x.Code, x.Message)
and
    MCException internal (e: Error, ex: exn, ?response: string) =
    inherit Exception(string e, ex)

    new(e: Error, ex: exn) = MCException(e, ex)

    member x.Error with get() = e
    member x.Response with get() = defaultArg response null


[<AutoOpen>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal MCException =

    let deserializeFail ex x =
        let e = Error("Failed to deserialize data.", -1)
        MCException(e, ex, x) |> raise

    let transformFail ex x =
        let e = Error("Failed to transform XML.", -2)
        MCException(e, ex, x) |> raise

    let callServerFail ex code x =
        let e = Error("Server call failed.", code)
        MCException(e, ex, x) |> raise

//==================================================================================
//  Api base
//==================================================================================

type WebMethod = Get = 0 | Post = 1

type Format =
    | json = 0
    | xml = 1
    | yaml = 2
    | php = 3
    | lolcode = 4

//------------------------------------------------------------------------------
//  (*) Api helper
//------------------------------------------------------------------------------

module private ApiHelper =

    let checkKey key =
        if isNullOrEmpty key  then
            invalidArg "key" "valid api key must be supplied"
        key

    let checkTimeout timeout =
        if timeout <= 0 then
            invalidArg "timeout" "valid timeout must be supplied"
        timeout

    let getDataCenter (key: string) =
        let x  = key.Split([|'-'|], 2)
        if x.Length < 2 then "us1" else x.[1]


module AH = ApiHelper

[<AbstractClass>]
type ApiBase(apiKey, ?secure, ?timeout) =
    let mutable apiKey: string = AH.checkKey apiKey
    let mutable secure: bool = defaultArg secure false
    let mutable timeout: int =
        defaultArg timeout 300 |> AH.checkTimeout

    abstract UserAgent: string
    abstract ApiUrl: string
    abstract OutputFormat: Format
    abstract KeyParam: string

    member x.ApiKey
        with get() = apiKey
        and set(v) = apiKey <- AH.checkKey v

    member x.Secure
        with get() = secure
        and set(v) = secure <- v

    member x.Timeout
        with get() = timeout
        and set(v) = timeout <- AH.checkTimeout v

    member x.HasDataCenter =
        (x.ApiUrl @? "").Contains("{dc}")

    member x.DataCenter =
        if not x.HasDataCenter then null
        else AH.getDataCenter apiKey

//------------------------------------------------------------------------------
//  (*) Api implementation
//------------------------------------------------------------------------------

module private ApiImpl =

    type UrlParams =
      { UrlFmt: string;
        DataCenter: string;
        Secure: bool;
        OutputFormat: Format;
        WebMethod: WebMethod;
        Method: string;
        Query: string }

    let getPathQuery webMethod query (uri: Uri) =
        String.Format("{0}{1}", uri.PathAndQuery,
            if webMethod = WebMethod.Get then
                (if isNullOrEmpty uri.Query then "?" else "&") + query
            else String.Empty)

    let getApiUrl (up: UrlParams) =
        let url = (up.UrlFmt @? "").Replace("{dc}", up.DataCenter).
                    Replace("{method}", up.Method).
                    Replace("{fmt}", up.OutputFormat.ToString())
        let uri = Uri(url)
        let pt = if up.Secure then "https" else "http"
        let pq = getPathQuery up.WebMethod up.Query uri
        String.Format("{0}://{1}{2}", pt, uri.Host, pq)

    let setInput keyParam key p =
        let p = defValue p (Input())
        p.[keyParam] <- key; p

    let getResponse webMethod methodName outFmt p (x: ApiBase) =
        let p = setInput x.KeyParam x.ApiKey p
        let q = Input.buildQueryString p
        let url =
          { UrlFmt = x.ApiUrl;
            DataCenter = x.DataCenter;
            Secure = x.Secure;
            OutputFormat = defValue outFmt x.OutputFormat;
            WebMethod = webMethod;
            Method = methodName;
            Query = q } |> getApiUrl

        let req = WebRequest.Create(url) :?> HttpWebRequest
        req.Timeout <- x.Timeout * 1000
        req.UserAgent <- x.UserAgent
        req.KeepAlive <- false

        if webMethod = WebMethod.Post then
            let b = getBytesASCII q
            req.Method <- "POST"
            req.ContentType <- "application/x-www-form-urlencoded"
            req.ContentLength <- b.LongLength

            use s = req.GetRequestStream()
            s.Write(b, 0, b.Length)
            s.Close()

        try req.GetResponse() :?> HttpWebResponse
        with
        | :? WebException as e -> e.Response :?> HttpWebResponse
        | e -> callServerFail e 0 null

    let callServer webMethod methodName outFmt p x =
        use resp = getResponse webMethod methodName outFmt p x
        use s = resp.GetResponseStream()
        resp.StatusCode, readStream s


module AI = ApiImpl

type ApiBase with

    member x.GetResponse(webMethod, methodName, [<op>]outFmt, [<op>]p) =
        AI.getResponse webMethod methodName outFmt p x

    member x.GetResponse(webMethod, methodName, ?outFmt, ?p) =
        AI.getResponse webMethod methodName ((<?)outFmt) ((<?)p) x

    member x.CallServer(webMethod, methodName, [<op>]outFmt, [<op>]p) =
        AI.callServer webMethod methodName outFmt p x

    member x.CallServer(webMethod, methodName, ?outFmt, ?p) =
        AI.callServer webMethod methodName ((<?)outFmt) ((<?)p) x